home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1995 August: Tool Chest / Dev.CD Aug 95 TC / Dev.CD Aug 95 TC.toast / Tool Chest / Development Tools & Languages / Dylan Related / Marlais / Marlais 0.5.9-portable sources / gc / misc.c < prev    next >
Encoding:
C/C++ Source or Header  |  1995-03-15  |  19.0 KB  |  694 lines  |  [TEXT/ttxt]
  1. /* 
  2.  * Copyright 1988, 1989 Hans-J. Boehm, Alan J. Demers
  3.  * Copyright (c) 1991-1994 by Xerox Corporation.  All rights reserved.
  4.  *
  5.  * THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED
  6.  * OR IMPLIED.  ANY USE IS AT YOUR OWN RISK.
  7.  *
  8.  * Permission is hereby granted to use or copy this program
  9.  * for any purpose,  provided the above notices are retained on all copies.
  10.  * Permission to modify the code and to distribute modified code is granted,
  11.  * provided the above notices are retained, and a notice that the code was
  12.  * modified is included with the above copyright notice.
  13.  */
  14. /* Boehm, February 10, 1995 12:37 pm PST */
  15.  
  16.  
  17. #include <stdio.h>
  18. #include <signal.h>
  19. #ifdef SOLARIS_THREADS
  20. # include <sys/syscall.h>
  21. #endif
  22.  
  23. #define I_HIDE_POINTERS    /* To make GC_call_with_alloc_lock visible */
  24. #include "gc_priv.h"
  25.  
  26. # ifdef THREADS
  27. #   ifdef PCR
  28. #     include "il/PCR_IL.h"
  29.       PCR_Th_ML GC_allocate_ml;
  30. #   else
  31. #     ifdef SRC_M3
  32.     /* Critical section counter is defined in the M3 runtime     */
  33.     /* That's all we use.                        */
  34. #     else
  35. #    ifdef SOLARIS_THREADS
  36.       mutex_t GC_allocate_ml;    /* Implicitly initialized.    */
  37. #    else
  38.       --> declare allocator lock here
  39. #    endif
  40. #     endif
  41. #   endif
  42. # endif
  43.  
  44. GC_FAR struct _GC_arrays GC_arrays = { 0 };
  45.  
  46.  
  47. bool GC_debugging_started = FALSE;
  48.     /* defined here so we don't have to load debug_malloc.o */
  49.  
  50. void (*GC_check_heap)() = (void (*)())0;
  51.  
  52. ptr_t GC_stackbottom = 0;
  53.  
  54. bool GC_dont_gc = 0;
  55.  
  56. bool GC_quiet = 0;
  57.  
  58. extern signed_word GC_mem_found;
  59.  
  60. # ifdef MERGE_SIZES
  61.     /* Set things up so that GC_size_map[i] >= words(i),        */
  62.     /* but not too much bigger                        */
  63.     /* and so that size_map contains relatively few distinct entries     */
  64.     /* This is stolen from Russ Atkinson's Cedar quantization        */
  65.     /* alogrithm (but we precompute it).                */
  66.  
  67.  
  68.     void GC_init_size_map()
  69.     {
  70.     register unsigned i;
  71.  
  72.     /* Map size 0 to 1.  This avoids problems at lower levels. */
  73.       GC_size_map[0] = 1;
  74.     /* One word objects don't have to be 2 word aligned.       */
  75.       for (i = 1; i < sizeof(word); i++) {
  76.           GC_size_map[i] = 1;
  77.       }
  78.       GC_size_map[sizeof(word)] = ROUNDED_UP_WORDS(sizeof(word));
  79.     for (i = sizeof(word) + 1; i <= 8 * sizeof(word); i++) {
  80. #           ifdef ALIGN_DOUBLE
  81.           GC_size_map[i] = (ROUNDED_UP_WORDS(i) + 1) & (~1);
  82. #           else
  83.           GC_size_map[i] = ROUNDED_UP_WORDS(i);
  84. #           endif
  85.     }
  86.     for (i = 8*sizeof(word) + 1; i <= 16 * sizeof(word); i++) {
  87.           GC_size_map[i] = (ROUNDED_UP_WORDS(i) + 1) & (~1);
  88.     }
  89.     /* We leave the rest of the array to be filled in on demand. */
  90.     }
  91.     
  92.     /* Fill in additional entries in GC_size_map, including the ith one */
  93.     /* We assume the ith entry is currently 0.                */
  94.     /* Note that a filled in section of the array ending at n always    */
  95.     /* has length at least n/4.                        */
  96.     void GC_extend_size_map(i)
  97.     word i;
  98.     {
  99.         word orig_word_sz = ROUNDED_UP_WORDS(i);
  100.         word word_sz = orig_word_sz;
  101.         register word byte_sz = WORDS_TO_BYTES(word_sz);
  102.                     /* The size we try to preserve.        */
  103.                     /* Close to to i, unless this would    */
  104.                     /* introduce too many distinct sizes.    */
  105.         word smaller_than_i = byte_sz - (byte_sz >> 3);
  106.         word much_smaller_than_i = byte_sz - (byte_sz >> 2);
  107.         register word low_limit;    /* The lowest indexed entry we     */
  108.                         /* initialize.            */
  109.         register word j;
  110.         
  111.         if (GC_size_map[smaller_than_i] == 0) {
  112.             low_limit = much_smaller_than_i;
  113.             while (GC_size_map[low_limit] != 0) low_limit++;
  114.         } else {
  115.             low_limit = smaller_than_i + 1;
  116.             while (GC_size_map[low_limit] != 0) low_limit++;
  117.             word_sz = ROUNDED_UP_WORDS(low_limit);
  118.             word_sz += word_sz >> 3;
  119.             if (word_sz < orig_word_sz) word_sz = orig_word_sz;
  120.         }
  121. #    ifdef ALIGN_DOUBLE
  122.         word_sz += 1;
  123.         word_sz &= ~1;
  124. #    endif
  125.     if (word_sz > MAXOBJSZ) {
  126.         word_sz = MAXOBJSZ;
  127.     }
  128.     /* If we can fit the same number of larger objects in a block,    */
  129.     /* do so.                            */ 
  130.     {
  131. #        ifdef ALIGN_DOUBLE
  132. #            define INCR 2
  133. #        else
  134. #        define INCR 1
  135. #        endif
  136.         while (BODY_SZ/word_sz == BODY_SZ/(word_sz + INCR)) word_sz += INCR;
  137.     }
  138.         byte_sz = WORDS_TO_BYTES(word_sz);
  139. #    ifdef ADD_BYTE_AT_END
  140.         /* We need one extra byte; don't fill in GC_size_map[byte_sz] */
  141.         byte_sz--;
  142. #    endif
  143.  
  144.         for (j = low_limit; j <= byte_sz; j++) GC_size_map[j] = word_sz;  
  145.     }
  146. # endif
  147.  
  148.  
  149. /*
  150.  * The following is a gross hack to deal with a problem that can occur
  151.  * on machines that are sloppy about stack frame sizes, notably SPARC.
  152.  * Bogus pointers may be written to the stack and not cleared for
  153.  * a LONG time, because they always fall into holes in stack frames
  154.  * that are not written.  We partially address this by clearing
  155.  * sections of the stack whenever we get control.
  156.  */
  157. word GC_stack_last_cleared = 0;    /* GC_no when we last did this */
  158. # define CLEAR_SIZE 213
  159. # define DEGRADE_RATE 50
  160.  
  161. word GC_min_sp;        /* Coolest stack pointer value from which we've */
  162.             /* already cleared the stack.            */
  163.             
  164. # ifdef STACK_GROWS_DOWN
  165. #   define COOLER_THAN >
  166. #   define HOTTER_THAN <
  167. #   define MAKE_COOLER(x,y) if ((word)(x)+(y) > (word)(x)) {(x) += (y);} \
  168.                 else {(x) = (word)ONES;}
  169. #   define MAKE_HOTTER(x,y) (x) -= (y)
  170. # else
  171. #   define COOLER_THAN <
  172. #   define HOTTER_THAN >
  173. #   define MAKE_COOLER(x,y) if ((word)(x)-(y) < (word)(x)) {(x) -= (y);} else {(x) = 0;}
  174. #   define MAKE_HOTTER(x,y) (x) += (y)
  175. # endif
  176.  
  177. word GC_high_water;
  178.             /* "hottest" stack pointer value we have seen    */
  179.             /* recently.  Degrades over time.        */
  180.  
  181. word GC_stack_upper_bound()
  182. {
  183.     word dummy;
  184.     
  185.     return((word)(&dummy));
  186. }
  187.  
  188. word GC_words_allocd_at_reset;
  189.  
  190. #if defined(ASM_CLEAR_CODE) && !defined(THREADS)
  191.   extern ptr_t GC_clear_stack_inner();
  192. #endif  
  193.  
  194. #if !defined(ASM_CLEAR_CODE) && !defined(THREADS)
  195. /* Clear the stack up to about limit.  Return arg. */
  196. /*ARGSUSED*/
  197. ptr_t GC_clear_stack_inner(arg, limit)
  198. ptr_t arg;
  199. word limit;
  200. {
  201.     word dummy[CLEAR_SIZE];
  202.     
  203.     BZERO(dummy, CLEAR_SIZE*sizeof(word));
  204.     if ((word)(dummy) COOLER_THAN limit) {
  205.         (void) GC_clear_stack_inner(arg, limit);
  206.     }
  207.     /* Make sure the recursive call is not a tail call, and the bzero    */
  208.     /* call is not recognized as dead code.                */
  209.     GC_noop(dummy);
  210.     return(arg);
  211. }
  212. #endif
  213.  
  214.  
  215. /* Clear some of the inaccessible part of the stack.  Returns its    */
  216. /* argument, so it can be used in a tail call position, hence clearing  */
  217. /* another frame.                            */
  218. ptr_t GC_clear_stack(arg)
  219. ptr_t arg;
  220. {
  221.     register word sp = GC_stack_upper_bound();
  222.     register word limit;
  223. #   ifdef THREADS
  224.         word dummy[CLEAR_SIZE];;
  225. #   endif
  226.     
  227. #   define SLOP 400
  228.     /* Extra bytes we clear every time.  This clears our own    */
  229.     /* activation record, and should cause more frequent        */
  230.     /* clearing near the cold end of the stack, a good thing.    */
  231. #   define GC_SLOP 4000
  232.     /* We make GC_high_water this much hotter than we really saw       */
  233.     /* saw it, to cover for GC noise etc. above our current frame.    */
  234. #   define CLEAR_THRESHOLD 100000
  235.     /* We restart the clearing process after this many bytes of    */
  236.     /* allocation.  Otherwise very heavily recursive programs    */
  237.     /* with sparse stacks may result in heaps that grow almost    */
  238.     /* without bounds.  As the heap gets larger, collection     */
  239.     /* frequency decreases, thus clearing frequency would decrease, */
  240.     /* thus more junk remains accessible, thus the heap gets    */
  241.     /* larger ...                            */
  242. # ifdef THREADS
  243.     BZERO(dummy, CLEAR_SIZE*sizeof(word));
  244. # else
  245.     if (GC_gc_no > GC_stack_last_cleared) {
  246.         /* Start things over, so we clear the entire stack again */
  247.         if (GC_stack_last_cleared == 0) GC_high_water = (word) GC_stackbottom;
  248.         GC_min_sp = GC_high_water;
  249.         GC_stack_last_cleared = GC_gc_no;
  250.         GC_words_allocd_at_reset = GC_words_allocd;
  251.     }
  252.     /* Adjust GC_high_water */
  253.         MAKE_COOLER(GC_high_water, WORDS_TO_BYTES(DEGRADE_RATE) + GC_SLOP);
  254.         if (sp HOTTER_THAN GC_high_water) {
  255.             GC_high_water = sp;
  256.         }
  257.         MAKE_HOTTER(GC_high_water, GC_SLOP);
  258.     limit = GC_min_sp;
  259.     MAKE_HOTTER(limit, SLOP);
  260.     if (sp COOLER_THAN limit) {
  261.         limit &= ~0xf;    /* Make it sufficiently aligned for assembly    */
  262.                 /* implementations of GC_clear_stack_inner.    */
  263.         GC_min_sp = sp;
  264.         return(GC_clear_stack_inner(arg, limit));
  265.     } else if (WORDS_TO_BYTES(GC_words_allocd - GC_words_allocd_at_reset)
  266.                > CLEAR_THRESHOLD) {
  267.         /* Restart clearing process, but limit how much clearing we do. */
  268.         GC_min_sp = sp;
  269.         MAKE_HOTTER(GC_min_sp, CLEAR_THRESHOLD/4);
  270.         if (GC_min_sp HOTTER_THAN GC_high_water) GC_min_sp = GC_high_water;
  271.         GC_words_allocd_at_reset = GC_words_allocd;
  272.     }  
  273. # endif
  274.   return(arg);
  275. }
  276.  
  277.  
  278. /* Return a pointer to the base address of p, given a pointer to a    */
  279. /* an address within an object.  Return 0 o.w.                */
  280. # ifdef __STDC__
  281.     extern_ptr_t GC_base(extern_ptr_t p)
  282. # else
  283.     extern_ptr_t GC_base(p)
  284.     extern_ptr_t p;
  285. # endif
  286. {
  287.     register word r;
  288.     register struct hblk *h;
  289.     register hdr *candidate_hdr;
  290.     register word limit;
  291.     
  292.     r = (word)p;
  293.     h = HBLKPTR(r);
  294.     candidate_hdr = HDR(r);
  295.     if (candidate_hdr == 0) return(0);
  296.     /* If it's a pointer to the middle of a large object, move it    */
  297.     /* to the beginning.                        */
  298.     while (IS_FORWARDING_ADDR_OR_NIL(candidate_hdr)) {
  299.        h = FORWARDED_ADDR(h,candidate_hdr);
  300.        r = (word)h + HDR_BYTES;
  301.        candidate_hdr = HDR(h);
  302.     }
  303.     if (candidate_hdr -> hb_map == GC_invalid_map) return(0);
  304.     /* Make sure r points to the beginning of the object */
  305.     r &= ~(WORDS_TO_BYTES(1) - 1);
  306.         {
  307.         register int offset =
  308.                 (char *)r - (char *)(HBLKPTR(r)) - HDR_BYTES;
  309.         register signed_word sz = candidate_hdr -> hb_sz;
  310.         
  311. #        ifdef ALL_INTERIOR_POINTERS
  312.           register map_entry_type map_entry;
  313.           
  314.           map_entry = MAP_ENTRY((candidate_hdr -> hb_map), offset);
  315.           if (map_entry == OBJ_INVALID) {
  316.                 return(0);
  317.               }
  318.               r -= WORDS_TO_BYTES(map_entry);
  319.               limit = r + WORDS_TO_BYTES(sz);
  320. #        else
  321.           register int correction;
  322.           
  323.           offset = BYTES_TO_WORDS(offset - HDR_BYTES);
  324.           correction = offset % sz;
  325.           r -= (WORDS_TO_BYTES(correction));
  326.           limit = r + WORDS_TO_BYTES(sz);
  327.           if (limit > (word)(h + 1)
  328.             && sz <= BYTES_TO_WORDS(HBLKSIZE) - HDR_WORDS) {
  329.             return(0);
  330.           }
  331. #        endif
  332.         if ((word)p >= limit) return(0);
  333.     }
  334.     return((extern_ptr_t)r);
  335. }
  336.  
  337.  
  338. /* Return the size of an object, given a pointer to its base.        */
  339. /* (For small obects this also happens to work from interior pointers,    */
  340. /* but that shouldn't be relied upon.)                    */
  341. # ifdef __STDC__
  342.     size_t GC_size(extern_ptr_t p)
  343. # else
  344.     size_t GC_size(p)
  345.     extern_ptr_t p;
  346. # endif
  347. {
  348.     register int sz;
  349.     register hdr * hhdr = HDR(p);
  350.     
  351.     sz = WORDS_TO_BYTES(hhdr -> hb_sz);
  352.     if (sz < 0) {
  353.         return(-sz);
  354.     } else {
  355.         return(sz);
  356.     }
  357. }
  358.  
  359. size_t GC_get_heap_size(NO_PARAMS)
  360. {
  361.     return ((size_t) GC_heapsize);
  362. }
  363.  
  364. size_t GC_get_bytes_since_gc(NO_PARAMS)
  365. {
  366.     return ((size_t) WORDS_TO_BYTES(GC_words_allocd));
  367. }
  368.  
  369. bool GC_is_initialized = FALSE;
  370.  
  371. void GC_init()
  372. {
  373.     DCL_LOCK_STATE;
  374.     
  375.     DISABLE_SIGNALS();
  376.     LOCK();
  377.     GC_init_inner();
  378.     UNLOCK();
  379.     ENABLE_SIGNALS();
  380.  
  381. }
  382.  
  383. #ifdef MSWIN32
  384.     extern void GC_init_win32();
  385. #endif
  386.  
  387. void GC_init_inner()
  388. {
  389.     word dummy;
  390.     
  391.     if (GC_is_initialized) return;
  392. #   ifdef MSWIN32
  393.      GC_init_win32();
  394. #   endif
  395. #   ifdef SOLARIS_THREADS
  396.     /* We need dirty bits in order to find live stack sections.    */
  397.         GC_dirty_init();
  398. #   endif
  399. #   if !defined(THREADS) || defined(SOLARIS_THREADS)
  400.       if (GC_stackbottom == 0) {
  401.     GC_stackbottom = GC_get_stack_base();
  402.       }
  403. #   endif
  404.     if  (sizeof (ptr_t) != sizeof(word)) {
  405.         ABORT("sizeof (ptr_t) != sizeof(word)\n");
  406.     }
  407.     if  (sizeof (signed_word) != sizeof(word)) {
  408.         ABORT("sizeof (signed_word) != sizeof(word)\n");
  409.     }
  410.     if  (sizeof (struct hblk) != HBLKSIZE) {
  411.         ABORT("sizeof (struct hblk) != HBLKSIZE\n");
  412.     }
  413. #   ifndef THREADS
  414. #     if defined(STACK_GROWS_UP) && defined(STACK_GROWS_DOWN)
  415.       ABORT(
  416.         "Only one of STACK_GROWS_UP and STACK_GROWS_DOWN should be defd\n");
  417. #     endif
  418. #     if !defined(STACK_GROWS_UP) && !defined(STACK_GROWS_DOWN)
  419.       ABORT(
  420.         "One of STACK_GROWS_UP and STACK_GROWS_DOWN should be defd\n");
  421. #     endif
  422. #     ifdef STACK_GROWS_DOWN
  423.         if ((word)(&dummy) > (word)GC_stackbottom) {
  424.           GC_err_printf0(
  425.               "STACK_GROWS_DOWN is defd, but stack appears to grow up\n");
  426.           GC_err_printf2("sp = 0x%lx, GC_stackbottom = 0x%lx\n",
  427.                       (unsigned long) (&dummy),
  428.                       (unsigned long) GC_stackbottom);
  429.           ABORT("stack direction 3\n");
  430.         }
  431. #     else
  432.         if ((word)(&dummy) < (word)GC_stackbottom) {
  433.           GC_err_printf0(
  434.               "STACK_GROWS_UP is defd, but stack appears to grow down\n");
  435.           GC_err_printf2("sp = 0x%lx, GC_stackbottom = 0x%lx\n",
  436.                           (unsigned long) (&dummy),
  437.                         (unsigned long) GC_stackbottom);
  438.           ABORT("stack direction 4");
  439.         }
  440. #     endif
  441. #   endif
  442. #   if !defined(_AUX_SOURCE) || defined(__GNUC__)
  443.       if ((word)(-1) < (word)0) {
  444.         GC_err_printf0("The type word should be an unsigned integer type\n");
  445.         GC_err_printf0("It appears to be signed\n");
  446.         ABORT("word");
  447.       }
  448. #   endif
  449.     if ((signed_word)(-1) >= (signed_word)0) {
  450.         GC_err_printf0(
  451.             "The type signed_word should be a signed integer type\n");
  452.         GC_err_printf0("It appears to be unsigned\n");
  453.         ABORT("signed_word");
  454.     }
  455.     
  456.     GC_init_headers();
  457.     /* Add initial guess of root sets */
  458.       GC_register_data_segments();
  459.     GC_bl_init();
  460.     GC_mark_init();
  461.     if (!GC_expand_hp_inner((word)MINHINCR)) {
  462.         GC_err_printf0("Can't start up: not enough memory\n");
  463.         EXIT();
  464.     }
  465.     /* Preallocate large object map.  It's otherwise inconvenient to     */
  466.     /* deal with failure.                        */
  467.       if (!GC_add_map_entry((word)0)) {
  468.         GC_err_printf0("Can't start up: not enough memory\n");
  469.         EXIT();
  470.       }
  471.     GC_register_displacement_inner(0L);
  472. #   ifdef MERGE_SIZES
  473.       GC_init_size_map();
  474. #   endif
  475. #   ifdef PCR
  476.       if (PCR_IL_Lock(PCR_Bool_false, PCR_allSigsBlocked, PCR_waitForever)
  477.           != PCR_ERes_okay) {
  478.           ABORT("Can't lock load state\n");
  479.       } else if (PCR_IL_Unlock() != PCR_ERes_okay) {
  480.           ABORT("Can't unlock load state\n");
  481.       }
  482.       PCR_IL_Unlock();
  483.       GC_pcr_install();
  484. #   endif
  485.     /* Get black list set up */
  486.       GC_gcollect_inner();
  487. #   ifdef STUBBORN_ALLOC
  488.         GC_stubborn_init();
  489. #   endif
  490.     GC_is_initialized = TRUE;
  491.     /* Convince lint that some things are used */
  492. #   ifdef LINT
  493.       {
  494.           extern char * GC_copyright[];
  495.           extern int GC_read();
  496.           extern void GC_register_finalizer_no_order();
  497.           
  498.           GC_noop(GC_copyright, GC_find_header, GC_print_block_list,
  499.                   GC_push_one, GC_call_with_alloc_lock, GC_read,
  500.                   GC_print_hblkfreelist, GC_dont_expand,
  501.                   GC_register_finalizer_no_order);
  502.       }
  503. #   endif
  504. }
  505.  
  506. void GC_enable_incremental(NO_PARAMS)
  507. {
  508.     DCL_LOCK_STATE;
  509.     
  510. # ifndef FIND_LEAK
  511.     DISABLE_SIGNALS();
  512.     LOCK();
  513.     if (GC_incremental) goto out;
  514. #   ifndef SOLARIS_THREADS
  515.         GC_dirty_init();
  516. #   endif
  517.     if (!GC_is_initialized) {
  518.         GC_init_inner();
  519.     }
  520.     if (GC_dont_gc) {
  521.         /* Can't easily do it. */
  522.         UNLOCK();
  523.         ENABLE_SIGNALS();
  524.         return;
  525.     }
  526.     if (GC_words_allocd > 0) {
  527.         /* There may be unmarked reachable objects    */
  528.         GC_gcollect_inner();
  529.     }   /* else we're OK in assuming everything's    */
  530.         /* clean since nothing can point to an          */
  531.         /* unmarked object.                  */
  532.     GC_read_dirty();
  533.     GC_incremental = TRUE;
  534. out:
  535.     UNLOCK();
  536.     ENABLE_SIGNALS();
  537. # endif
  538. }
  539.  
  540.  
  541. #ifdef MSWIN32
  542. # define LOG_FILE "gc.log"
  543. # include <windows.h>
  544.  
  545.   HANDLE GC_stdout = 0, GC_stderr;
  546.   int GC_tmp;
  547.   DWORD GC_junk;
  548.  
  549.   void GC_set_files()
  550.   {
  551.     if (!GC_stdout) {
  552.         GC_stdout = CreateFile(LOG_FILE, GENERIC_WRITE, FILE_SHARE_READ,
  553.                        NULL, CREATE_ALWAYS, FILE_FLAG_WRITE_THROUGH,
  554.                        NULL); 
  555.         if (INVALID_HANDLE_VALUE == GC_stdout) ABORT("Open of log file failed");
  556.     }
  557.     if (GC_stderr == 0) {
  558.     GC_stderr = GC_stdout;
  559.     }
  560.   }
  561.  
  562. #endif
  563.  
  564. #if defined(OS2) || defined(MACOS)
  565. FILE * GC_stdout = NULL;
  566. FILE * GC_stderr = NULL;
  567. int GC_tmp;  /* Should really be local ... */
  568.  
  569.   void GC_set_files()
  570.   {
  571.       if (GC_stdout == NULL) {
  572.     GC_stdout = stdout;
  573.     }
  574.     if (GC_stderr == NULL) {
  575.     GC_stderr = stderr;
  576.     }
  577.   }
  578. #endif
  579.  
  580. #if !defined(OS2) && !defined(MACOS) && !defined(MSWIN32)
  581.   int GC_stdout = 1;
  582.   int GC_stderr = 2;
  583. # if !defined(AMIGA)
  584. #   include <unistd.h>
  585. # endif
  586. #endif
  587.  
  588. #ifdef SOLARIS_THREADS
  589. #   define WRITE(f, buf, len) syscall(SYS_write, (f), (buf), (len))
  590. #else
  591. # ifdef MSWIN32
  592. #   define WRITE(f, buf, len) (GC_set_files(), \
  593.                    GC_tmp = WriteFile((f), (buf), \
  594.                                  (len), &GC_junk, NULL),\
  595.                    (GC_tmp? 1 : -1))
  596. # else
  597. #   if defined(OS2) || defined(MACOS)
  598. #   define WRITE(f, buf, len) (GC_set_files(), \
  599.                    GC_tmp = fwrite((buf), 1, (len), (f)), \
  600.                    fflush(f), GC_tmp)
  601. #   else
  602. #     define WRITE(f, buf, len) write((f), (buf), (len))
  603. #   endif
  604. # endif
  605. #endif
  606.  
  607. /* A version of printf that is unlikely to call malloc, and is thus safer */
  608. /* to call from the collector in case malloc has been bound to GC_malloc. */
  609. /* Assumes that no more than 1023 characters are written at once.      */
  610. /* Assumes that all arguments have been converted to something of the      */
  611. /* same size as long, and that the format conversions expect something      */
  612. /* of that size.                              */
  613. void GC_printf(format, a, b, c, d, e, f)
  614. char * format;
  615. long a, b, c, d, e, f;
  616. {
  617.     char buf[1025];
  618.     
  619.     if (GC_quiet) return;
  620.     buf[1024] = 0x15;
  621.     (void) sprintf(buf, format, a, b, c, d, e, f);
  622.     if (buf[1024] != 0x15) ABORT("GC_printf clobbered stack");
  623.     if (WRITE(GC_stdout, buf, strlen(buf)) < 0) ABORT("write to stdout failed");
  624. }
  625.  
  626. void GC_err_printf(format, a, b, c, d, e, f)
  627. char * format;
  628. long a, b, c, d, e, f;
  629. {
  630.     char buf[1025];
  631.     
  632.     buf[1024] = 0x15;
  633.     (void) sprintf(buf, format, a, b, c, d, e, f);
  634.     if (buf[1024] != 0x15) ABORT("GC_err_printf clobbered stack");
  635.     if (WRITE(GC_stderr, buf, strlen(buf)) < 0) ABORT("write to stderr failed");
  636. }
  637.  
  638. void GC_err_puts(s)
  639. char *s;
  640. {
  641.     if (WRITE(GC_stderr, s, strlen(s)) < 0) ABORT("write to stderr failed");
  642. }
  643.  
  644. # if defined(__STDC__) || defined(__cplusplus)
  645.     void GC_default_warn_proc(char *msg, GC_word arg)
  646. # else
  647.     void GC_default_warn_proc(msg, arg)
  648.     char *msg;
  649.     GC_word arg;
  650. # endif
  651. {
  652.     GC_err_printf1(msg, (unsigned long)arg);
  653. }
  654.  
  655. GC_warn_proc GC_current_warn_proc = GC_default_warn_proc;
  656.  
  657. # if defined(__STDC__) || defined(__cplusplus)
  658.     GC_warn_proc GC_set_warn_proc(GC_warn_proc p)
  659. # else
  660.     GC_warn_proc GC_set_warn_proc(p)
  661.     GC_warn_proc p;
  662. # endif
  663. {
  664.     GC_warn_proc result;
  665.  
  666.     LOCK();
  667.     result = GC_current_warn_proc;
  668.     GC_current_warn_proc = p;
  669.     UNLOCK();
  670.     return(result);
  671. }
  672.  
  673.  
  674. #ifndef PCR
  675. void GC_abort(msg)
  676. char * msg;
  677. {
  678.     GC_err_printf1("%s\n", msg);
  679.     (void) abort();
  680. }
  681. #endif
  682.  
  683. # ifdef SRC_M3
  684. void GC_enable()
  685. {
  686.     GC_dont_gc--;
  687. }
  688.  
  689. void GC_disable()
  690. {
  691.     GC_dont_gc++;
  692. }
  693. # endif
  694.